home *** CD-ROM | disk | FTP | other *** search
/ Especial Multimedia / Especial Multimedia.iso / Multimed / Prg / BMP2PIC.ZIP / BMP2PIC.BAS < prev    next >
BASIC Source File  |  1997-09-14  |  2KB  |  50 lines
  1. Option Explicit
  2.  
  3. ' Written by:  Ron Edwards
  4. '              PRISM Corp.            Please don't hesitate to point out bugs or make
  5. '              Hiroshima, Japan       other suggestions/comments.  Samples of your unique
  6. '              CIS:  71125,534        solutions to programming challenges are appreciated.
  7.  
  8. ' Windows API Declarations/Definitions
  9.  
  10. ' Function's
  11. Declare Function BitBlt% Lib "GDI" (ByVal hDestDC%, ByVal X%, ByVal Y%, ByVal nWidth%, ByVal nHeight%, ByVal hSrcDC%, ByVal XSrc%, ByVal YSrc%, ByVal dwRop&)
  12. Declare Function CreateCompatibleBitmap% Lib "GDI" (ByVal hDC%, ByVal nWidth%, ByVal nHeight%)
  13. Declare Function CreateCompatibleDC% Lib "GDI" (ByVal hDC%)
  14. Declare Function DeleteDC% Lib "GDI" (ByVal hDC%)
  15. Declare Function DeleteObject% Lib "GDI" (ByVal hObject%)
  16. Declare Function GetBitmapBits& Lib "GDI" (ByVal hBitmap%, ByVal dwCount&, ByVal lpBits As Any)
  17. Declare Function GlobalLock& Lib "Kernel" (ByVal hMem%)
  18. Declare Function GlobalSize& Lib "Kernel" (ByVal hMem%)
  19. Declare Function GlobalUnlock% Lib "Kernel" (ByVal hMem%)
  20. Declare Function SelectObject% Lib "GDI" (ByVal hDC%, ByVal hObject%)
  21.  
  22. ' Constants
  23. Const SRCCOPY = &HCC0020
  24.  
  25. ' User defined globals
  26. Global rc%, i%
  27. Global ctlSOURCE As Control, ctlDEST As Control, ctlREALKEY As Control
  28.  
  29. Sub CopyBmp2Pic (keyleft%, keytop%)
  30.     Dim compatDC%, compatbmp%, bmpsize&, memptr&
  31.     
  32.     compatDC% = CreateCompatibleDC(ctlDEST.hDC)  ' Must use control that has hDC
  33.     compatbmp% = CreateCompatibleBitmap(compatDC%, 17, 17)
  34.     rc% = SelectObject(compatDC%, ctlDEST.Picture)  ' Must already contain the same kind/size bmp
  35.     
  36.     rc% = BitBlt(compatDC%, 0, 0, 17, 17, ctlSOURCE.hDC, keyleft% + 2, keytop% + 2, SRCCOPY)
  37.     bmpsize& = GlobalSize(compatbmp%)
  38.     
  39.     memptr& = GlobalLock(ctlDEST.Picture)
  40.     rc% = GetBitmapBits(compatbmp%, bmpsize&, memptr& + bmpsize&)
  41.     rc% = GlobalUnlock(ctlDEST.Picture)
  42.     
  43.     ctlREALKEY.PictureUp = ctlDEST.Picture  ' Copy to the key
  44.     
  45.     rc% = DeleteDC(compatDC%)
  46.     rc% = DeleteObject(compatbmp%)
  47.  
  48. End Sub
  49.  
  50.